home *** CD-ROM | disk | FTP | other *** search
Text File | 1989-02-11 | 9.2 KB | 220 lines | [TEXT/TRUE] |
- ! PopUp Menu Demo
- ! True Basic version 2.01
- ! Requires True Basic Macintosh Developer's ToolKit Libraries
- ! by Dave Kelly
- ! ©1989 MacTutor
-
- REM Open up libraries
- LIBRARY "MenuLib*" ! Menu Manager
- LIBRARY "WindowLib*" ! Window Manager
- LIBRARY "DeskLib*" ! Desk Manager
- LIBRARY "EventLib*" ! Event Manager
- LIBRARY "QuickLib*" ! Quickdraw
- LIBRARY "DataLib*" ! Desk Acc and system calls
- LIBRARY "MacLib*" ! True Basic event control
- LIBRARY "System*" ! System Calls
-
- REM The following variables are used globally throughout the program
- DECLARE DEF NIL$, POINTER$,screenBits$,bounds$,top,left,bottom,right,TopLeft$,H,V
- DECLARE DEF OpenDeskAcc,NewWindow$,SystemEdit
- DECLARE DEF MenuSelect,PtInRect,TrackGoAway
-
- DIM MyMenus$(1:4)
- DIM PopItem$(1:3)
- CALL SysEnvirons(sysEnvRec$,status) ! Get current system revision
- CALL UnpackEnvirons(sysEnvRec$,envversion, machine,sysversion,processor, hasFPU,hasColorQD,keyboardtype,atversion, sysvrefnum)
- IF sysversion=0 then ! Do we have the right ROM?
- STOP
- END IF
- CALL TakeMac ! turn off True Basic and let the program do its own thing
- LET everyevent=-1 ! event mask for all events
- LET doneFlag=0 ! this flag is set when program ending has been selected.
- LET z$=bounds$(screenBits$) ! Get the size of the screen.
- CALL setrect(r$,left(z$)+4,top(z$)+44,right(z$)-4,bottom(z$)-4)
- CALL setrect(dragrect$,4,24,right(z$)-4,bottom(z$)-4)
- LET myWindow$=NewWindow$(NIL$,r$,"Sample",1,0,POINTER$(-1),1,0) ! Create a window
- CALL SetPort(myWindow$) ! Access the new window
- CALL SetUpMenus ! Turn on menus
- CALL Drawwindow ! Set up window info
-
- ! Main Event Loop
-
- DO
- CALL SystemTask ! Handle System tasks/DAs
- CALL GetNextEvent(everyevent,theEvent$,eResult) ! check for events
- IF eResult<>0 then ! if no event error occurred then...
- CALL UnpackEvent(theEvent$,what,mess,when,where$,mod)
- SELECT CASE what ! what represents the kind of event that occurred.
- CASE 1 ! mouse down event occurred
- CALL FindWindow(where$,whichWindow$,wResult)
- SELECT CASE wResult
- CASE 1 ! Event was in the menu bar
- LET mResult=MenuSelect(where$)
- CALL DoMenu(mResult)
- CASE 2 ! Event was in a system window
- CALL SystemClick(theEvent$,whichWindow$) ! Pass the event to the system
- CASE 3 ! Event was in the content region of a window
- CALL GlobalToLocal(where$) ! convert coordinates for the window
- IF PtInRect(where$,PopRect$)=1 THEN ! see if popup was selected
- CALL PopUpEvent ! if so, then handle the popup event
- END IF
- CASE 4 ! Event in the window's drag region
- CALL DragWindow(whichWindow$,where$,dragrect$)
- CASE 6 ! Event in go-away region of active window
- LET doneFlag=TrackGoAway(whichWindow$,where$)
- CASE else
- END SELECT
- CASE 6 ! update event occurred
- CALL Packb(w$,1,32,mess)
- CALL BeginUpdate(w$)
- CALL Drawwindow
- CALL DrawPopUp
- CALL EndUpdate(w$)
- CASE else ! anything else?
- END SELECT
- END IF
- LOOP until doneFlag<>0
-
- CALL DisposeWindow(myWindow$) ! Throw away window handle
- CALL ClearMenuBar ! Clear Menus
- FOR i=Lbound(MyMenus$) to Ubound(MyMenus$)
- CALL DisposeMenu(MyMenus$(i))
- NEXT i
- CALL GiveMac ! Return control back to True Basic
- STOP ! End the program
-
- SUB DrawWindow ! Draw message in window
- CALL textfont(2) ! Set font to New York font
- CALL textsize(12) ! Set size to 12 point
- CALL textface(1) ! Set text to bold
- CALL textmode(0) ! Set to copy mode
- CALL moveto(10,20)
- CALL DrawString("True BASIC Version 2.0 PopUp Menu demo")
- CALL textface(0) ! Set text to plain
- END SUB
-
- SUB DoMenu(code) ! handle Menu events
- CALL Packb(s$,1,32,code)
- LET MenuNumber=Unpackb(s$,1,-16)
- LET Menuitem = Unpackb(s$,17,-16)
- SELECT CASE MenuNumber
- CASE 1 ! Apple Menu
- CALL GetItem(MyMenus$(1),MenuItem,name$)
- LET mrefNum=OpenDeskAcc(name$)
- CALL SetPort(mywindow$)
- CASE 2 ! File Menu
- LET doneFlag=-1
- CASE 3 ! Edit Menu
- LET z=SystemEdit(Menuitem+1)
- CASE else
- END SELECT
- CALL HiliteMenu(0)
- END SUB
-
- SUB SetUpMenus
- DECLARE DEF NewMenu$,StringWidth ! Declare variables used
- DECLARE DEF GetFontInfo$ ! in toolbox functions
-
- LET MyMenus$(1)=NewMenu$(1,chr$(20)) ! The first menu is the
- CALL AddResMenu(MyMenus$(1),"DRVR") ! Apple menu.
- LET MyMenus$(2)=NewMenu$(2,"File") ! The File menu is second
- CALL AppendMenu(MyMenus$(2),"Quit")
- LET MyMenus$(3)=NewMenu$(3,"Edit") ! Next the Edit menu
- CALL AppendMenu(MyMenus$(3),"Cut")
- CALL AppendMenu(MyMenus$(3),"Copy")
- CALL AppendMenu(MyMenus$(3),"Paste")
- LET PopTitle$="PopUp Menu Title: " ! Save the pop up title
- LET MyMenus$(4)=NewMenu$(4,PopTitle$) ! Create the pop up menu
- LET Popitem$(1)="Item 1"
- LET Popitem$(2)="Item 2"
- LET Popitem$(3)="Item 3"
- LET NoOfPopItems=3
- LET PopItem=1
- FOR i=1 to 3
- CALL AppendMenu(MyMenus$(4),Popitem$(i)) ! Add popup items
- NEXT i
- FOR i=lbound(MyMenus$) to Ubound(MyMenus$)-1 ! put the menus into
- CALL insertMenu(MyMenus$(i),0) ! the menu bar
- NEXT i
- CALL InsertMenu(MyMenus$(4),-1) ! Add pop up menu
- CALL CheckItem(MyMenus$(4),PopItem,1) ! check default item
-
- REM Get maximum length of PopUp items
- CALL TextFont(0) ! Set to system font
- CALL TextSize(12) ! Set to 12 point size
- CALL GetFontInfo(FontInfo$)
- LET ascent = Unpackb(fontinfo$,1,-16)
- LET descent = Unpackb(fontinfo$,17,-16)
- LET widMax = Unpackb(fontinfo$,33,-16)
- LET leading = Unpackb(fontinfo$,49,-16)
- LET MaxItemLength=0
- FOR i=1 to NoOfPopItems
- LET strwidth=StringWidth(Popitem$(i))
- IF StrWidth>MaxItemLength then LET MaxItemLength=StrWidth
- NEXT i
- CALL DrawPopUp
- CALL DrawMenuBar
- END SUB
-
- SUB DrawPopUp
- CALL TextFont(0) ! Set Font to Chicago (System)
- CALL TextSize(12) ! Set Size to 12 point
- LET Popuptop=100 ! Top of Popup menu
- LET Popupleft=200 ! Left of Popup menu
- CALL SetRect(PopRect$,Popupleft,Popuptop,Popupleft+5+MaxItemLength+13,Popuptop+ascent+descent+leading+1)
- CALL FrameRect(PopRect$) ! Draw the currently selected item
- CALL MoveTo(Right(PopRect$),Top(PopRect$)+1)
- CALL LineTo(Right(PopRect$),Bottom(PopRect$))
- CALL MoveTo(Left(PopRect$)+1,Bottom(PopRect$))
- CALL LineTo(Right(PopRect$),Bottom(PopRect$))
- LET StrWidth=StringWidth(PopTitle$)
- LET xlocation=Left(PopRect$)-StrWidth
- LET ylocation=(Top(PopRect$)+Bottom(PopRect$))/2+(ascent-descent)/2
- CALL MoveTo(xlocation,ylocation)
- CALL Drawstring(PopTitle$) ! Draw the Popup menu title
- CALL SetRect(InvertTitleRect$,xlocation-8,Top(PopRect$)+1,Left(PopRect$),Bottom(PopRect$))
- LET xlocation=Left(PopRect$)+13
- CALL MoveTo(xlocation,ylocation)
- CALL Drawstring(PopItem$(PopItem)) ! Draw the currently selected item
- END SUB
-
- SUB PopUpEvent
- DECLARE DEF PopUpMenuSelect ! Declare function
- CALL InvertRect(InvertTitleRect$) ! invert the popup title
- LET TempPoint$=TopLeft$(PopRect$)
- CALL LocalToGlobal(TempPoint$) ! Change to global coordinates
- LET PopTop=V(TempPoint$)+1
- LET PopLeft=H(TempPoint$)+1
- LET Result=PopUpMenuSelect(MyMenus$(4),PopTop,PopLeft,PopItem) ! Do the Popup
- CALL Packb(s$,1,32,Result) ! Get the menu result
- LET MenuNumber=Unpackb(s$,1,-16) ! Ignore Menunumber, we know which menu this is
- LET Menuitem = Unpackb(s$,17,-16) ! Get the menu item
- IF MenuItem=PopItem THEN
- CALL InvertRect(InvertTitleRect$) ! Invert the title to normal if old item selected
- ELSE
- CALL CheckItem(MyMenus$(4),PopItem,0) ! uncheck last item
- CALL CheckItem(MyMenus$(4),MenuItem,1) ! check new item
- CALL EraseRect(PopRect$) ! Draw the current menu item
- CALL FrameRect(PopRect$)
- CALL MoveTo(xlocation,ylocation)
- CALL Drawstring(PopItem$(PopItem))
- CALL InvertRect(InvertTitleRect$)
- SELECT CASE MenuItem ! Handle menu event
- CASE 1
- REM Do Item 1
- LET PopItem=MenuItem
- CASE 2
- REM Do Item 2
- LET PopItem=MenuItem
- CASE 3
- REM Do Item 3
- LET PopItem=MenuItem
- CASE ELSE
- END SELECT
- CALL MoveTo(xlocation,ylocation)
- CALL TextFont(0) ! Set font to Chicago (System)
- CALL Drawstring(PopItem$(PopItem)) ! draw the selected popup item
- END IF
- END SUB
- END
-